perm filename REVEAL.FAI[GEM,HE]3 blob
sn#065805 filedate 1973-10-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.
C00007 00003 FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
C00010 00004 SUBR(MKPIMG) MAKE PERCIEVED IMAGES FROM CRE IMAGES.
C00012 00005
C00014 00006 SUBR(MKSIMG,CAMR) MAKE SYNTHETIC IMAGE FROM OCCULT RESULTS.
C00016 00007
C00018 00008
C00020 00009 SUBR(MKCONE,BODY,Z1,Z2)
C00022 00010 SUBR(SETZPP,FACE,ZDEPTH,CAMERA)
C00024 ENDMK
C⊗;
TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.
;DEFINE CRE LINK NAMES.
%←←1B18
DEFINE LEFT $(NAM,WRD){
DEFINE NAM(A,Q)<CAR A,%+WRD(Q)>
DEFINE NAM$.(A,Q)<DIP A,%+WRD(Q)>}
DEFINE RIGHT $(NAM,WRD){
DEFINE NAM(A,Q)<CDR A,%+WRD(Q)>
DEFINE NAM$.(A,Q)<DAP A,%+WRD(Q)>}
LEFT(%CW, 0)↔RIGHT(%CCW,0) ;RING LINKS.
LEFT(%DAD,1)↔RIGHT(%SON,1) ;TREE OF RINGS.
LEFT(%TYP,2)↔RIGHT(%ALT,2)
LEFT(%ROW,3)↔RIGHT(%COL,3) ;IMAGE LOCUS.
LEFT(%ENDO,3)↔RIGHT(%EXO,3) ;NESTED POLYGON TREE.
LEFT(%ARC,4)
↓ZDEPTH←←5
LEFT(%NGON,5)↔RIGHT(%PGON,5) ;NESTED POLYGON TREE.
LEFT(%NTIM,6)↔RIGHT(%PTIM,6) ;TIME LINE LINKS.
;-----------------------------------------------------------------
DEFINE TJOINT(Q,V)<CAR Q,2(V)>
EXTERN ECW,ECCW
;FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
COMMENT ⊗
The Next Visible Edge Conjecture - the next visible edge CW
(or CCW) about a vertex in 3D (from the external side of a
polyhedron) must be the next visible edge CW (or CCW) about that
vertex in any 2D image in which the retex is visible.
⊗
SUBR(QCW,EDGE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔ U←←16 ↔ V←←15 ↔ E←←14
LAC V,VERTEX↔LAC 1,EDGE
TESTZ V,JUTBIT↔GO L1
TESTZ V,JOTBIT↔GO L2
L0: CALL(ECW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J ;¬TJ.
L1: PVT U,1↔TJOINT V,V↔PED 1,V ;JUT.
CAME U,VERTEX↔POP2J
CALL(ECCW,1,V)↔POP2J
L2: NVT U,1↔CAME U,V↔GO L3 ;JOT.
CALL(ECCW,1,V)↔POP2J
L3: TJOINT 1,V↔PED 1,1↔POP2J
ENDR QCW;8/4/73(BGB)-------------------------------------------------
SUBR(QCCW,EDGE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔ U←←16 ↔ V←←15 ↔ E←←14
LAC V,VERTEX↔LAC 1,EDGE
TESTZ V,JUTBIT↔GO L1
TESTZ V,JOTBIT↔GO L2
L0: CALL(ECCW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J ;¬TJ.
L1: NVT U,1↔TJOINT V,V↔PED 1,V ;JUT.
CAME U,VERTEX↔POP2J
CALL(ECCW,1,V)↔POP2J
L2: PVT U,1↔CAME U,V↔GO L3 ;JOT.
CALL(ECCW,1,V)↔POP2J
L3: TJOINT 1,V↔PED 1,1↔POP2J
ENDR QCCW;8/4/73(BGB)------------------------------------------------
SUBR(MKPIMG) ;MAKE PERCIEVED IMAGES FROM CRE IMAGES.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
ACCUMULATORS{A,B,C,D,E}
SKIPN A,%+1↔POP0J
DAC A,%IMG↔DAC A,%IMG0 ;FIRST CRE IMAGE OF FILM.
;GET CONTEXT OF THESE IMAGES.
LAC 1,UNIVERSE
NWRLD 1,1↔DAC 1,WORLD ;"NOW" WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;"NOW" CAMERA.
;MAKE A GEOMED IMAGE.
L4: SETQ(IMG,{MKNODE,[PBIT+$IMAGE]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
LAC WORLD↔PWRLD. 0,1 ;WORLD OF THIS IMAGE.
LAC C,CAMERA↔NCAMR. C,1 ;CAMERA OF THIS IMAGE.
;PLACE THE IMAGE INTO THE CAMERA'S PERCEIVED IMAGE RING.
PIMAG A,C↔JUMPN A,L4A ;JUMP WHEN ¬NEW RING.
PTIME. 1,1↔NTIME. 1,1↔GO L5B
L4A: PTIME B,A
PTIME. 1,A↔NTIME. A,1
PTIME. B,1↔NTIME. 1,B
L5B: PIMAG. 1,C
LAC A,%IMG↔%SON A,A
DAC A,%LEV↔DAC A,%LEV0 ;FIRST LEVEL OF IMAGE.
L3: LAC A,%LEV↔%SON A,A
DAC A,%PGN↔DAC A,%PGN0 ;FIRST POLYGON OF LEVEL.
L2: LAC A,%PGN↔%SON A,A
DAC A,%V↔DAC A,%V0 ;FIRST VERTEX OF POLYGON.
SETQ(BDY,{MKB,IMG}) ;ONE BODY PER POLYGON.
SETQ(FACE,{MKF,BDY})
SETQ(V0,{MKV,BDY})↔DAC 1,V
;COPY THE CRE-VECTORS INTO GEOMED EDGES & VERTICES.
L1: LAC 2,%V
%ROW 0,2↔FLO↔FSB[108.0]
DACN YPP(1)↔FMPR[0.04]↔DACN YWC(1)
%COL 0,2↔FLO↔FSB[144.0]
DAC XPP(1)↔FMPR[0.04]↔DAC XWC(1)
SLACI(<131072.0>)↔DACN ZPP(1) ;ZDEPTH PERSPECTIVE 2↑17.
%CCW 2,2↔DAC 2,%V ;NEXT VECTOR.
CAME 2,%V0↔GO[
SETQ(V,{MKEV,FACE,V})↔PED E,1
MARK E,POTENT↔GO L1] ;NEXT EDGE.
CALL(MKFE,V0,FACE,V)↔MARK 1,POTENT ;LAST EDGE.
;CLOSE LOOPS.
LAC 1,%PGN↔%CCW 1,1↔DAC 1,%PGN ;NEXT POLYGON.
CAME 1,%PGN0↔GO L2
LAC 1,%LEV↔%CCW 1,1↔DAC 1,%LEV ;NEXT LEVEL.
CAME 1,%LEV0↔GO L3
LAC 1,%IMG↔%CCW 1,1↔DAC 1,%IMG ;NEXT IMAGE.
CAME 1,%IMG0↔GO L4
LAC 1,IMG↔POP0J
DECLARE{CAMERA,WORLD}
DECLARE{BDY,FACE,V,V0,%V,%V0,%PGN,%PGN0,%LEV,%LEV0,IMG,%IMG,%IMG0}
ENDR MKPIMG;3/14/73(BGB)------------------------------------------
SUBR(MKSIMG,CAMR) ;MAKE SYNTHETIC IMAGE FROM OCCULT RESULTS.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
ACCUMULATORS{A,B,C,D,E,F,Q,V,U}
;GET CONTEXT OF THIS IMAGE.
LAC 1,UNIVERSE
NWRLD 1,1↔DAC 1,WORLD ;"NOW" WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;"NOW" CAMERA.
;MAKE A GEOMED IMAGE.
SETQ(IMG,{MKNODE,[PBIT+$IMAGE]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
LAC WORLD↔PWRLD. 0,1 ;WORLD OF THIS IMAGE.
LAC C,CAMERA↔NCAMR. C,1 ;CAMERA OF THIS IMAGE.
;PLACE THE IMAGE INTO THE CAMERA'S PERCEIVED IMAGE RING.
SIMAG A,C↔JUMPN A,L1 ;JUMP WHEN ¬NEW RING.
PTIME. 1,1↔NTIME. 1,1↔GO L2
L1: PTIME B,A
PTIME. 1,A↔NTIME. A,1
PTIME. B,1↔NTIME. 1,B
L2: SIMAG. 1,C
SETQ(BDY,{MKB,IMG}) ;ONE BODY PER IMAGE.
SETQ(BGND,{MKF,BDY}) ;BACK GROUND FACE.
LAC E,WORLD↔PED E,E
SKIPA
;COPY ALL THE VISIBLE EDGES.
L3: ALT2 E,E↔JUMPE E,L6
SETQ(Q,{MKE↑,BDY})
ALT. E,Q↔ALT. Q,E
CAR(E)↔ANDI(DARKEN+NSHARP+FOLDED+VISIBLE+EBIT)↔DIP(Q)
;COPY THE FACES OF EACH EDGE.
NFACE F,E↔TESTZ E,FOLDED↔UFACE F,E ;FACE OR UNDER FACE.
JUMPE F,.+2
TEST F,POTENT↔GO[LAC U,BGND↔GO L3N] ;BACKGROUND.
TESTZ F,TBIT1↔GO[ALT U,F↔GO L3N]
MARK F,TBIT1
SETQ(U,{MKF,BDY})
LAC 1,1(U)↔SLACI AA(F)↔LAPI AA(U)↔BLT 8(U)↔DAC 1,1(U)
ALT. F,U↔ALT. U,F↔PED. Q,U
L3N: NFACE. U,Q
PFACE F,E
TEST F,POTENT↔GO[LAC U,BGND↔GO L3P] ;BACKGROUND.
TESTZ F,TBIT1↔GO[ALT U,F↔GO L3P]
MARK F,TBIT1
SETQ(U,{MKF,BDY})
LAC 1,1(U)↔SLACI AA(F)↔LAPI AA(U)↔BLT 8(U)↔DAC 1,1(U)
ALT. F,U↔ALT. U,F↔PED. Q,U
L3P: PFACE. U,Q
;COPY THE VERTICES OF EACH EDGE.
NVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
TESTZ V,TBIT1↔GO[ALT U,V↔GO L4N]
MARK V,TBIT1
SETQ(U,{MKV↑,BDY})
ALT. V,U↔ALT. U,V↔PED. Q,U
LAC XPP(V)↔DAC XPP(U) ;PP LOCUS.
LAC YPP(V)↔DAC YPP(U)
LAC XWC(V)↔DAC XWC(U) ;WC LOCUS.
LAC YWC(V)↔DAC YWC(U)
LAC ZWC(V)↔DAC ZWC(U)
L4N: NVT. U,Q
PVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
TESTZ V,TBIT1↔GO[ALT U,V↔GO L4P]
MARK V,TBIT1
SETQ(U,{MKV↑,BDY})
ALT. V,U↔ALT. U,V↔PED. Q,U
LAC XPP(V)↔DAC XPP(U)
LAC YPP(V)↔DAC YPP(U)
LAC XWC(V)↔DAC XWC(U) ;WC LOCUS.
LAC YWC(V)↔DAC YWC(U)
LAC ZWC(V)↔DAC ZWC(U)
L4P: PVT. U,Q
GO L3
;FIX UP THE WING LINKS.
L6: LAC E,WORLD↔PED E,E↔SKIPA
L7: ALT2 E,E↔JUMPE E,POP1J.↔ALT Q,E
PVT V,E
CALL(QCCW,E,V)↔ALT 1,1↔PCW. 1,Q
CALL(QCW,E,V)↔ ALT 1,1↔NCCW. 1,Q
NVT V,E
CALL(QCCW,E,V)↔ALT 1,1↔NCW. 1,Q
CALL(QCW,E,V)↔ ALT 1,1↔PCCW. 1,Q
GO L7
DECLARE{CAMERA,WORLD,BDY,IMG,BGND}
ENDR MKSIMG;7/13/73(BGB)------------------------------------------
SUBR(MKCONE,BODY,Z1,Z2)
COMMENT ⊗------------------------------------------------------------
⊗
;CHECK BODY ARGUMENT.
LAC 1,BODY↔TEST 1,BBIT↔POP3J
SETQ(BNEW,{MKCOPY↑,BODY}) ;COPY LAMINA INTO NOW WORLD.
PFACE 1,1↔DAC 1,FACE ;FIRST FACE.
;GET NOW CAMERA.
LAC 1,UNIVERSE↑↔NWRLD 1,1 ;NOW WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;NOW CAMERA.
;CONVERT Z ARGUMENT FROM ZDEPTH ≡ ABS(ZCC) INTO ZPP.
LACN 1,3(1)↔FSC 1,=17↔LAC 2,1 ;-FOCAL*2↑17
FDVR 1,Z1↔FDVR 2,Z2
DACM 1,Z1↔DACM 2,Z2
CALL(SETZPP,FACE,Z1,CAMERA)
CALL(SWEEP↑,FACE,[0]) ;SWEEP SILHOUETTE CONE.
CALL(SETZPP,FACE,Z2,CAMERA)
LAC 1,BNEW
POP3J
DECLARE{CAMERA,BNEW,FACE}
ENDR MKCONE;9/3/73(BGB)----------------------------------------------
SUBR(SETZPP,FACE,ZDEPTH,CAMERA)
COMMENT ⊗------------------------------------------------------------
Clock around all the vertices of a face setting their ZPP.
⊗
LAC 1,FACE↔PED 1,1 ;1ST EDGE OF FACE.
DAC 1,EDGE0↔DAC 1,EDGE
L1: SETQ(VERTEX,{VCCW↑,EDGE,FACE})
LAC ZDEPTH↔DAC ZPP(1) ;ZPP OF VERTEX.
CALL(UNPROJECT↑,VERTEX,CAMERA) ;UNPROJECT THE VERTEX.
SETQ(EDGE,{ECCW↑,EDGE,FACE}) ;GET NEXT EDGE.
CAME 1,EDGE0↔GO L1 ;TEST FOR 1ST EDGE.
POP3J
DECLARE{EDGE,EDGE0,VERTEX}
ENDR SETZPP;9/3/73(BGB)----------------------------------------------
END
REVEAL.FAI - EOF.